perm filename HE.OLD[SYS,HE] blob
sn#080520 filedate 1974-03-14 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00024 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00007 00002 BEGIN "HE"
00012 00003 ⊃ Now for three arrays preloaded with command information.
00015 00004 ⊃ OUTER LEVEL VARIABLES
00019 00005 ⊃ MISC. ROUTINES
00023 00006 MESSAGE PROCEDURE TRACING STUFF
00027 00007 ⊃ SCANLOOP scans all input devices for input waiting.
00029 00008 ⊃ next check if there are any TTY strings
00031 00009 ⊃ finally, check PTY buffers for input ready
00033 00010 ⊃ TYPEX types all strings to TTY. It handles suppress and
00035 00011 ⊃ Now for some routines to help control the pseudo-teletypes.
00039 00012 ⊃ This is the command scanner. It is called if the scanner
00042 00013 ⊃ next process new strings, if any
00046 00014 ⊃ This is the command decoder, and is called by COMSCAN if a
00050 00015 ⊃ check for command errors
00054 00016 ⊃ KILL
00057 00017 ⊃ RAID MODE -- INDEX IS '7
00060 00018 ⊃ TRACE -- INDEX IS '15
00063 00019 ⊃ DISKIN, FOLLOWED BY FILE-NAME, READS IN FILE AS COMMANDS
00065 00020 ⊃ RESTART - INDEX IS 21
00069 00021 ⊃ SET - Takes one argument, D(EBUG), T(YPE), or DI(SPLAY).
00071 00022 ⊃ system commands which turn off the display
00073 00023 ⊃ ********** Execution Block **********
00076 00024 ⊃ main loop
00077 ENDMK
⊗;
BEGIN "HE"
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "HELIB[1,3]" LIBRARY;
REQUIRE "HEINIT[SYS,HE]" LOAD_MODULE;
REQUIRE -1 NEW_ITEMS;
REQUIRE 4000 STRING_SPACE;
COMMENT This is a program designed to handle psuedo-teletypes for the
hand-eye system.;
EXTERNAL PROCEDURE HEINIT(REFERENCE INTEGER TABLE; INTEGER NAM, DEV);
EXTERNAL INTEGER PROCEDURE PTYGTL(INTEGER X);
EXTERNAL PROCEDURE PTYSTL(INTEGER X,Y);
EXTERNAL PROCEDURE INTWAIT;
EXTERNAL PROCEDURE INTINT(BOOLEAN A,B,C);
EXTERNAL INTEGER _SKIP_, _JCNT_, _JTAB_, _JD1_, _JD2_;
FORWARD PROCEDURE COMMAND(STRING CD);
LET DEFINE=REDEFINE;
DEFINE ⊃="COMMENT",TYPE="OUTSTR(",CR="'15",
LF="'12",CRLF="('15&'12)",CREOM="&CRLF)",
EOM=")",BIT(X,Y)="X LAND Y",
TTYMOD="1",TRACEB="4",SUPPRESS="'10",MONINDX="1",
TILSEMI="1",TILCOLON="2",TILDELIM="3",SKPDELIM="6",
IDENT="4",TILCR="5",TRACECHN="1",TPMON="'400000000",
SUBCHN="2", CRM="&CRLF,MONINDX"
,DSKCHN="3", SAFEX="SAFE", TILCOMMA="8", TILBREAK="7";
⊃ MONITOR COMMAND TABLE.
LOW 2 OCTAL DIGITS ARE INDEX INTO COMMAND CASE STAT.
NEXT 2 OCTAL DIGITS ARE NUMBER OF PARAMS REQUIRED.
IF 0 -- NO SCANNING IS DONE.
IF '77 -- SCAN AN INDEFINITE NUMBER OF PARAMS.
'10000 -- IF ON, DO NOT CHECK FOR VALID JOB NAME (E,G, LOGIN)
'20000 -- IF ON, THIS COMMAND CAN BE APPLIED TO THE MONITOR
'40000 -- IF ON, THIS COMMAND CAN BE APPLIED TO ALL SUBJOBS AT ONCE;
DEFINE SYST="'4",RPG="'3", MSYST="'40004";
DEFINE CMDS="
XX('10027,3,EXPERT),
XX('10030,3,NOVICE),
XX('17700,3,LOGIN),
XX('17720,6,DISKIN),
XX('17717,3,DEFINE),
XX('40001,1,KILL),
XX('40002,1,HALT),
XX('60005,4,CHAR),
XX('60006,4,LINE),
XX('17721,4,RESTART),
XX('10025,2,DUMP),
XX('40022,4,STATUS),
XX('50123,3,SET),
XX('50124,5,RESET),
XX('7,4,RAID),
XX('10,3,EOF),
XX('11,2,DD),
XX('40012,8,SUPPRESS),
XX('40013,8,UNSUPPRESS),
XX('60014,6,UPDATE),
XX('60015,5,TRACE),
XX('60016,7,UNTRACE),
XX(RPG,2,EXECUTE),
XX(RPG,3,TRY),
XX(RPG,3,DEBUG),
XX(RPG,3,LOAD),
XX(RPG,2,EDIT),
XX(RPG,3,COMPILE),
XX(RPG,3,CREATE),
XX(RPG,4,CREF),
XX(RPG,3,DELETE),
XX(RPG,4,TYPE),
XX(RPG,3,DIRECTORY),
XX(RPG,4,LIST),
XX(RPG,3,RENAME),
XX(RPG,3,ZERO),
XX(RPG,3,PROCESS),
XX(SYST,3,SYSTEM),
XX(SYST,2,ASSIGN),
XX(MSYST,3,CONTINUE),
XX(MSYST,4,CCONTINUE),
XX(SYST,5,COREX),
XX(SYST,3,DAYTIME),
XX(SYST,3,DEASSIGN),
XX(MSYST,3,FINISH),
XX(MSYST,4,PPPN),
XX('26,3,REENTER),
XX(SYST,4,SAVE),
XX(SYST,2,ALIAS),
XX(MSYST,2,PJOB),
XX('40026,1,START),
XX('31,1,RUN),
XX(SYST,1,GET),
XX(MSYST,1,CORE),
XX(SYST,1,EXAMINE),
XX(MSYST,4,TIME)
";
DEFINE COMNO="56";
⊃ Now for three arrays preloaded with command information.
COMACT has good bits telling the command decoder what to do.
COMLEN tells how many characters of the names need be compared.
COMSTR is the name of the command. ;
DEFINE XX(A,B,C)="A"; PRELOAD_WITH CMDS;
SAFEX INTEGER ARRAY COMACT[1:COMNO];
DEFINE XX(A,B,C)="B"; PRELOAD_WITH CMDS;
SAFEX INTEGER ARRAY COMLEN[1:COMNO];
DEFINE XX(A,B,C)="""C"""; PRELOAD_WITH CMDS;
SAFEX STRING ARRAY COMSTR[1:COMNO];
DEFINE MAXJOB="16";
⊃ Tables indexed by the job id number.
JOBNO is the actual system job number. If zero, all data in the
other tables is invalid.
PTYLIN pseudo-teletype number for this job.
MODE contains bits:
low order bit=1 for character mode, 0 for line mode.
TRACEB turns on tracing for this job
SUPPRESS suppresses output from this job
because PTY buffer was too full [MONINDX ONLY]
ACT_HE indicates that this job has a string in PARTSTR
which needs processing.
LOGNAM contains the logical name of this job.
SAVSTR contains a string which should be output to the user. (1 string only)
PARTSTR accumulates lines until ready for user.
MACRO contains macro bodies
MACARG contains argument character for the macros, if any
MACNAM contains macro names
MACSTAK contains saved macrstrings on recursion.
TIME contains the last job runtime recorded
HANG_STR contains strings for jobs whose input buffers are full.
JOBHUNG will be TRUE if any entrys are non-null;
SAFEX INTEGER ARRAY JOBNO,PTYLIN,MODE,ACT_HE,TIME[1:MAXJOB];
SAFEX STRING ARRAY LOGNAM,SAVSTR,PARTSTR,HANG_STR[1:MAXJOB];
define MAXMACRO="1020";
SAFEX STRING ARRAY MACRO[1000:MAXMACRO];
SAFEX STRING ARRAY MACNAM[1000:MAXMACRO];
SAFEX STRING ARRAY MACSTACK[1:20];
SAFEX STRING ARRAY MACARG[1000:MAXMACRO];
SAFEX STRING ARRAY ARGS[1:10];
⊃ OUTER LEVEL VARIABLES ;
INTEGER WAK, ⊃ TRUE if input from a PTY waiting to be processed;
COMJOB, ⊃ job number current command is to be applied to,
0 if all jobs;
MONWAK, ⊃ TRUE if input from TTY, disk, or macro waiting
to be processed;
MACRTOP, ⊃ index in MACRO of last macro defined;
HANG_CNT, ⊃ counts number of seconds jobs have been hung;
MACDEPTH, ⊃ depth of macro nesting;
DSKFLAG, ⊃ TRUE if DISKIN being executed;
MONNUM, ⊃ job number of this program;
EOFDSK,BREAKDSK, MES,FLAG,BREAK,EOF,EOF2;
STRING CURCOM, ⊃ default destination for commands;
OLDOUT, ⊃ current source logical name for TTY output;
CURDEST, ⊃ default destination for PTY strings;
MACRSTRING, ⊃ current macro being processed, if any;
TRACFIL; ⊃ name of trace file, whether being used or not;
BOOLEAN TRACFLAG, ⊃ suppresses tracing for next output only;
NOVICE, ⊃ false if default names allowed;
JOBHUNG, ⊃ at least one job's i/o is temporarily hung;
INITFLAG; ⊃ set by RESTART command to force reinitialization;
LABEL INIT;
⊃ below are the jobs defined in the hand/eye system and their global flags;
DEFINE JBS="
ZZ(EDG,DEB_EDGE,TYP_EDGE,YES_EDGE,DIS_EDGE),
ZZ(CAM,DEB_CAM,TYP_CAM,YES_CAM,DIS_CAM),
ZZ(VER,DEB_VER,TYP_VER,YES_VER,DIS_VER),
ZZ(COL,DEB_COL,TYP_COL,YES_COL,DIS_COL),
ZZ(HAND,DEB_HAND,TYP_HAND,YES_HAND,DIS_HAND),
ZZ(MOVE,DEB_MOVE,TYP_MOVE,YES_MOVE,DIS_MOVE),
ZZ(DRV,DEB_DRV,TYP_DRV,YES_DRV,DIS_DRV),
ZZ(GUN,DEB_GUN,TYP_GUN,YES_GUN,DIS_GUN),
ZZ(FOC,DEB_FOC,TYP_FOC,YES_FOC,DIS_FOC),
ZZ(EYE,DEB_EYE,TYP_EYE,YES_EYE,DIS_EYE),
ZZ(CUR,DEB_CUR,TYP_CUR,YES_CUR,DIS_CUR)
";
DEFINE NUMBJOB="11"; ⊃ NUMBER OF JOBS DEFINED ABOVE AND IN PREAMBLE;
⊃ JOB_NAME contains the names of the defined jobs;
DEFINE ZZ(A,B,C,D,E)="""A""";
PRELOAD_WITH JBS;
SAFEX STRING ARRAY JOB_NAME[1:NUMBJOB];
⊃ MISC. ROUTINES;
⊃ turn off display frames put out by job I (III displays only for now);
PRELOAD_WITH 0,0;
SAFEX INTEGER ARRAY BUF[0:1];
SIMPLE PROCEDURE DPYCLEAR(STRING NAM; INTEGER T);
BEGIN INTEGER J, K, I;
K ← '703000000000;
FOR I ← 1 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I]∧EQU(NAM,LOGNAM[I]) THEN DONE;
IF I>MAXJOB THEN RETURN;
FOR J ← 0 STEP 1 UNTIL 14 DO IF GDISP[J]=JOBNO[I] THEN
BEGIN
CODE(K LOR ((J LAND '17) LSH 23),BUF[0]);
IF T THEN GDISP[J] ← -1;
END;
END;
⊃ PROCEDURE TO SET AND RESET FLAGS (USED IN COMMAND DECODER);
SIMPLE PROCEDURE DOIT(STRING NAM; INTEGER CHAR; BOOLEAN FLG);
BEGIN INTEGER J,K;
FOR J←1 STEP 1 UNTIL NUMBJOB DO IF EQU(JOB_NAME[J],NAM) THEN DONE;
IF J≤NUMBJOB THEN IF CHAR="E" THEN
BEGIN DEFINE ZZ(A,B,C,D,E)="B←FLG";
K←CASE J-1 OF (JBS);
END ELSE IF CHAR="T" THEN
BEGIN DEFINE ZZ(A,B,C,D,E)="C←FLG";
K←CASE J-1 OF (JBS);
END ELSE IF CHAR="I" THEN
BEGIN DEFINE ZZ(A,B,C,D,E)="E←FLG";
IF ¬FLG THEN DPYCLEAR(NAM,FALSE);
K←CASE J-1 OF (JBS);
END;
END;
⊃ Procedure to determine job size;
INTEGER C223, C212, TOTAL_SIZE, C225, C216, C230, C213, MAX_SIZE, C231, C235;
SIMPLE INTEGER PROCEDURE CORE(INTEGER JOB);
BEGIN INTEGER A;
A ← CALL(C223+JOB,"PEEK");
A←IF A THEN ((A LSH -18)+1) DIV 1024 ELSE
CALL(C212+JOB,"PEEK") LAND '777;
TOTAL_SIZE ← TOTAL_SIZE+A;
IF A>MAX_SIZE THEN MAX_SIZE ← A;
RETURN(A);
END;
⊃ OUTPUT MILLISECOND TIME AS MIN:SEC.FRACTION ;
SIMPLE STRING PROCEDURE TIMOUT(INTEGER I);
BEGIN INTEGER J,K;
J ← I DIV 1000;
K ← J DIV 60;
RETURN(CVS(K)&":"&CVS(J-K*60)&"."&CVS(I-J*1000));
END;
⊃ format strings;
STRING BLANKS;
SIMPLE STRING PROCEDURE FORM(STRING IN; INTEGER LEN);
RETURN((IN&BLANKS)[1 FOR LEN]);
COMMENT MESSAGE PROCEDURE TRACING STUFF;
PRELOAD_WITH "I","F","","","L","S","Lp","St","It","","","Iv";
SAFEX STRING ARRAY BITSTRING[1:12];
FORWARD SIMPLE PROCEDURE TYPEX(BOOLEAN FLAG;STRING STR; INTEGER INDEX);
SIMPLE MESSAGE PROCEDURE TRACE (INTEGER UNIQUE,ARGS);
BEGIN STRING FF;
DEFINE MOVE="'200000000000";
SIMPLE INTEGER PROCEDURE GETVAL(INTEGER ARGS);
START_CODE
MOVE 1,ARGS;
MOVE 1,(1);
END;
SIMPLE REAL PROCEDURE GETREAL(INTEGER ARGS);
START_CODE
MOVE 1,ARGS;
MOVE 1,(1);
END;
SIMPLE STRING PROCEDURE GETSTRING(INTEGER ARGS);
BEGIN STRING FOO;
INTEGER I,J,K,L,M;
FOO ← NULL;
START_CODE
MOVE 1,ARGS;
MOVE 1,(1);
MOVE 2,(1);
MOVEM 2,M;
IDIVI 2,5;
SKIPE 3;
AOS 2;
MOVEM 2,I;
HRRZ 1,1(1);
MOVEM 1,K;
END;
FOR J ← 1 STEP 1 UNTIL I DO
BEGIN
START_CODE
MOVE 1,K;
MOVE 1,(1);
MOVEM 1,L;
AOS K;
END;
FOO ← FOO&CVSTR(L);
END;
RETURN(""""&FOO[1 TO M]&"""");
END;
SIMPLE STRING PROCEDURE GETBITS(INTEGER BITS);
BEGIN INTEGER I;
STRING FOO;
FOO ← NULL;
FOR I ← 1 STEP 1 UNTIL 12 DO
IF BITS LAND 2↑(I-1) THEN FOO ← FOO&BITSTRING[I];
IF BITS LAND '200000 THEN FOO ← FOO&"G";
BITS ← BITS ROT -18;
IF BITS LAND 1 THEN FOO←FOO&"A";
IF BITS LAND '2000 THEN FOO←FOO&"R";
IF BITS LAND '4000 THEN FOO←FOO&"V";
RETURN(FOO);
END;
SIMPLE STRING PROCEDURE GETARGS(INTEGER ARGS);
BEGIN DEFINE STRINGB="'200", FLOAT="2", INTGER="1";
INTEGER COUNT, I, BITS;
STRING FOO;
COUNT ← GETVAL(ARGS-1);
SETFORMAT (1,4);
ARGS ← ARGS+3;
FOO ← NULL;
FOR I ← 1 STEP 1 UNTIL COUNT DO
BEGIN
BITS ← GETVAL (ARGS+1);
FOO ← FOO&" "&(IF BITS LAND '1004560 THEN
GETBITS(BITS) ELSE IF BITS LAND FLOAT THEN
CVF(GETREAL(ARGS)) ELSE IF BITS LAND INTGER
THEN CVS(GETVAL(ARGS)) ELSE IF BITS LAND
STRINGB THEN GETSTRING(ARGS) ELSE
GETBITS(BITS));
ARGS ← ARGS+2;
END;
RETURN(FOO);
END;
OUTSTR (FF←CVS(GETVAL(ARGS+2))&" MESSAGE TRACE: "&
GET_DATA(1,UNIQUE)&" "&GET_DATA(2,UNIQUE)&" "&
GET_DATA(3,UNIQUE)&GETARGS(ARGS)&CRLF );
OUT (TRACECHN,FF);
FF ← NULL;
END;
⊃ message procedure to send commands to the monitor from other jobs;
SIMPLE MESSAGE PROCEDURE MON_COM(STRING COM);
BEGIN
OUTSTR(COM&CRLF);
PARTSTR[MONINDX] ← PARTSTR[MONINDX]&COM&CRLF;
MONWAK ← ACT_HE[MONINDX] ← 1;
END;
⊃ SCANLOOP scans all input devices for input waiting.
Any found is appended to the string in PARTSTR and ACT_HE is set.
If there is enough string to qualify for output, that string is put in SAVSTR.
If, during the scan, PTY input of any kind was detected, WAK is set
to 1, if any other input was detected, MONWAK is set. Devices are not checked
until all available strings have been processed. ;
PROCEDURE SCANLOOP;
BEGIN "SCAN"
INTEGER I,A,INP_READY;
STRING STR;
LABEL TTYINP, PTYINP;
WAK←MONWAK←0;
⊃ first check for MACROS to be processed;
WHILE LENGTH(MACRSTRING) DO
BEGIN "MACROS"
SAVSTR[MONINDX]←SCAN(MACRSTRING,TILCR,FLAG);
IF LENGTH(SAVSTR[MONINDX]) THEN
BEGIN "ENDMAC"
MONWAK←1;
RETURN;
END "ENDMAC" ELSE BEGIN "MACEND"
TYPEX(FALSE,"END MACRO" CRM);
MACRSTRING←MACSTACK[MACDEPTH];
MACDEPTH←MACDEPTH-1;
IF ¬MACDEPTH THEN DONE;
END "MACEND";
END "MACROS";
⊃ next check for disk input;
IF DSKFLAG THEN
BEGIN "DISKIN"
SAVSTR[MONINDX]←INPUT(DSKCHN,TILCR);
MONWAK ← 1;
IF ¬EOFDSK THEN
BEGIN "EOF"
DSKFLAG←0;
MONWAK ← 0;
RELEASE (DSKCHN);
TYPEX(FALSE,"END DISKIN" CRM);
END "EOF" ELSE RETURN;
END "DISKIN";
⊃ next check if there are any TTY strings
already read if not, check if any more are waiting;
CASE BIT(MODE[MONINDX],TTYMOD) OF
BEGIN "CASE"
BEGIN "LINE"
TTYINP: IF ACT_HE[MONINDX] THEN
BEGIN "INPUT"
STR ← SCAN(PARTSTR[MONINDX],TILCR,FLAG);
IF FLAG='12 THEN
BEGIN "FULL"
SAVSTR[MONINDX] ← STR;
MONWAK ← 1;
STR ← NULL;
RETURN;
END "FULL" ELSE BEGIN "PARTIAL"
PARTSTR[MONINDX] ← STR;
ACT_HE[MONINDX]←0;
END "PARTIAL";
END "INPUT";
STR←INCHSL(FLAG);
IF ¬ FLAG THEN
BEGIN
PARTSTR[MONINDX]←PARTSTR[MONINDX]&STR&CRLF;
ACT_HE[MONINDX] ← 1;
GO TO TTYINP;
END;
END "LINE";
BEGIN "CHAR"
STR←NULL;
DO BEGIN
A←INCHRS;
IF A>0 THEN STR←STR&A;
END UNTIL A<0;
IF LENGTH(STR) THEN
BEGIN
SAVSTR[MONINDX] ← SAVSTR[MONINDX]&STR;
MONWAK ← 1;
STR ← NULL;
RETURN;
END;
END "CHAR";
END "CASE";
⊃ finally, check PTY buffers for input ready
for processing;
PTYINP: FOR I←2 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I]∧ACT_HE[I] THEN CASE BIT(MODE[I],TTYMOD) OF
BEGIN "SCNJOB"
BEGIN "LINE";
STR←SCAN(PARTSTR[I],TILCR,FLAG);
IF FLAG='12 THEN
BEGIN
SAVSTR[I]←STR;
WAK←1;
END ELSE BEGIN
PARTSTR[I]←STR; ⊃ LEFT OVER CHARACTERS ;
ACT_HE[I] ← 0;
END;
END "LINE";
BEGIN "CHAR"
SAVSTR[I]←SAVSTR[I]&PARTSTR[I];
PARTSTR[I]←NULL ; ⊃ SO THINGS DO NOT ACCUMULATE ;
IF LENGTH(SAVSTR[I]) THEN WAK←2;
ACT_HE[I] ← 0;
END "CHAR";
END "SCNJOB" ;
INP_READY ← FALSE;
⊃ if no strings found, check devices for more input;
IF ¬WAK THEN FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I] THEN
BEGIN "PTYIN"
STR←PTYALL(PTYLIN[I]);
IF LENGTH(STR) THEN
BEGIN
ACT_HE[I] ← 1;
INP_READY ← TRUE;
PARTSTR[I]←PARTSTR[I]&STR; ⊃ ACCUMULATE CHARS;
END;
END "PTYIN";
IF INP_READY THEN GO TO PTYINP;
STR ← NULL;
END "SCAN";
⊃ TYPEX types all strings to TTY. It handles suppress and
trace processing. If FLAG is TRUE this is an error message which
should flush DISKIN if being executed;
SIMPLE PROCEDURE TYPEX(BOOLEAN FLAG;STRING STR; INTEGER I);
BEGIN LABEL L1;
L1: IF BIT(TRACEB,MODE[I])∨BIT(TRACEB,MODE[MONINDX]) THEN
OUT(TRACECHN, LOGNAM[I]&"→"&"TTY "&STR);
IF ¬ BIT(SUPPRESS,MODE[I]) THEN
BEGIN "OUTW"
TYPE (IF EQU(LOGNAM[I],OLDOUT) THEN NULL ELSE
(LOGNAM[I])&"+")&STR EOM;
OLDOUT←LOGNAM[I];
END "OUTW";
IF FLAG∧DSKFLAG THEN
BEGIN
FLAG ← DSKFLAG ← FALSE;
RELEASE(DSKCHN);
STR ← "DISKIN TERMINATED"&CRLF;
GO TO L1;
END;
END;
⊃ PROCESS_STRINGS takes care of pushing at the user any strings
dumped in SAVSTR by SCANLOOP. If tracing or suppress is on, appropriate
action is taken here.
;
SIMPLE PROCEDURE PROCESS_STRINGS;
BEGIN
INTEGER I;
FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I]∧ACT_HE[I] THEN
BEGIN
TYPEX(FALSE,SAVSTR[I]&CRLF,I);
SAVSTR[I] ← NULL
END;
END;
⊃ Now for some routines to help control the pseudo-teletypes.
SEND is used to send strings at the pty for a job id number.
SNARF waits until a certain character is seen from that PTY.
(It really waits -- you do not get back to the scan loop).
SNARFMON arranges for that PTY to be in monitor mode. TRUE IF EXITED OK.
WAITI waits for a character from a given PTY and returns it.
HALT halts the job id number in COMJOB by sending ↑C↑C and
calling SNARFMON.;
SIMPLE PROCEDURE SEND(INTEGER X;STRING Y; BOOLEAN FLAG);
BEGIN
STRING N;
IF ¬TRACFLAG∧(BIT(TRACEB,MODE[X])∨BIT(TRACEB,MODE[MONINDX])) THEN
BEGIN
N←IF DSKFLAG THEN "DISK" ELSE
IF LENGTH(MACRSTRING) THEN "MACR" ELSE "TTY";
OUT(TRACECHN,(IF FLAG THEN N&"→"&LOGNAM[X]&" " ELSE "")&Y);
END;
TRACFLAG ← FALSE;
PTOSTR(PTYLIN[X],Y);
END;
STRING SNARF_STRING;
SIMPLE PROCEDURE SNARF(INTEGER X,Y);
SNARF_STRING ← SNARF_STRING&PTYSTR(PTYLIN[X],Y);
SIMPLE BOOLEAN PROCEDURE SNARFMON (INTEGER X);
BEGIN ⊃ SNARF UNTIL IN MONITOR MODE ;
INTEGER IOS,J;
IOS←0;
J ← 15;
WHILE ¬BIT(IOS,TPMON)∧J>0 DO
BEGIN
IOS←CALL(CVSIX("TTY"&CVOS(PTYLIN[X] LAND '777)),"TTYIOS");
IF ¬BIT(IOS,TPMON) THEN CALL(1,"SLEEP");
J ← J-1;
END;
IF J>0 THEN
BEGIN
SNARF_STRING←SNARF_STRING&PTYALL(PTYLIN[X]);
IF ¬(CALL(JOBNO[X],"JBTSTS") LAND '40000000000) THEN
RETURN(FALSE);
RETURN(TRUE);
END;
RETURN(FALSE);
END;
SIMPLE INTEGER PROCEDURE WAITI(INTEGER X);
BEGIN INTEGER Y,Z;
Y←-1;
WHILE Y<0 DO
BEGIN
Y←PTCHRS(PTYLIN[X]);
IF Y<0 THEN CALL(1,"SLEEP");
END;
RETURN (Y);
END;
SIMPLE PROCEDURE HALT;
BEGIN INTEGER I;
IF COMJOB THEN
BEGIN
TRACFLAG ← TRUE;
SEND(COMJOB,'3&'3,TRUE);
IF ¬SNARFMON (COMJOB) THEN TYPEX(TRUE,"HALT FAILED" CRM);
END ELSE FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I] THEN
BEGIN
TRACFLAG ← TRUE;
SEND(I,'3&'3,TRUE);
IF ¬SNARFMON (I) THEN TYPEX(TRUE, "HALT FAILED" CRM);
END;
END;
⊃ this procedure makes CVSTR honest;
SIMPLE STRING PROCEDURE CVSTRX(INTEGER A);
BEGIN STRING FOO; INTEGER I;
I ← LENGTH(FOO← CVSTR(A));
WHILE I≥0∧¬FOO[I FOR 1] DO I←I-1;
RETURN(IF I THEN FOO[1 FOR I] ELSE NULL);
END;
⊃ This is the command scanner. It is called if the scanner
loop detected that there was input from the TTY. It checks to see
if there is a new job destination & if so stores the logical name
in CURDEST. If there is a command, the logical name of the
destination is stored in CURCOM, and the job id number in COMJOB.
If there is no command, the line is typed at the appropriate
PTY job (that with CURDEST as logical name). If a job's input buffer
is full, the string is put in HANG_STR until the job is ready for it.
JOBHUNG is set if any strings are in HANG_STR
;
PROCEDURE COMSCAN;
BEGIN LABEL L1, L2, L3;
STRING TSTR1,TSTR2,STR;
INTEGER I, COUNT;
IF BIT(MODE[MONINDX],TTYMOD) THEN
TYPEX(FALSE, "TTY MODE CONFUSION" CRM);
IF NOVICE THEN CURCOM ← CURDEST ← NULL;
⊃ first check for strings in HANG_STR and process if found;
IF JOBHUNG THEN
BEGIN
JOBHUNG ← FALSE;
FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I] THEN
WHILE LENGTH(HANG_STR[I]) DO
BEGIN "HANGOT"
STR ← SCAN(HANG_STR[I],TILCR,FLAG);
COUNT ← PTIFRE(PTYLIN[I]);
IF LENGTH(STR)+2≤COUNT THEN SEND(I,STR&CRLF,TRUE)
ELSE BEGIN
JOBHUNG←TRUE;
HANG_STR[I]←STR&CRLF&HANG_STR[I];
DONE;
END;
END "HANGOT";
IF JOBHUNG THEN
BEGIN
IF (HANG_CNT←HANG_CNT+1)>30 THEN
BEGIN
TYPEX(FALSE,"JOBS NOT ACCEPTING INPUT" CRM);
HANG_CNT ← 0;
END;
CALL(1,"SLEEP");
END ELSE HANG_CNT ← 0;
END;
⊃ next process new strings, if any;
TSTR1←STR←SAVSTR[MONINDX];
IF ¬MONWAK THEN RETURN ELSE SAVSTR[MONINDX] ← NULL;
TSTR2←SCAN(TSTR1,TILSEMI,FLAG);
IF FLAG=";" AND LENGTH(TSTR2)≤4 THEN
BEGIN
CURDEST←TSTR2;
STR←TSTR1; ⊃ TRUNCATED STRING ;
GO TO L2;
END;
⊃ string is a command - process and send to COMMAND;
TSTR1←STR;
TSTR2←SCAN(TSTR1,TILCOLON,FLAG);
IF FLAG=":" ∧ LENGTH(TSTR2)≤4 THEN
BEGIN
COMJOB ← 0;
IF LENGTH(TSTR2) THEN CURCOM←TSTR2;
IF LENGTH(TSTR1) ∧ TSTR1=":" THEN
BEGIN
TSTR1←TSTR1[2 TO ∞];
GO TO L1;
END;
IF LENGTH(CURCOM) THEN
BEGIN
FOR COMJOB←1 STEP 1 UNTIL MAXJOB DO
IF JOBNO[COMJOB]∧EQU(CURCOM,LOGNAM[COMJOB])
THEN DONE;
END;
L1: COMMAND(TSTR1);
TSTR1 ← TSTR2 ← STR ← NULL;
RETURN;
END;
⊃ string is to a PTY - process and send if possible;
L2: IF EQU(CURDEST,"MON") THEN TYPEX(FALSE,STR CRM) ELSE
BEGIN "SEND"
IF ¬LENGTH(CURDEST)∧NOVICE THEN GO TO L3;
FOR I←2 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I] ∧ EQU(LOGNAM[I],CURDEST) THEN
BEGIN
STR ← STR&CRLF;
IF ¬JOBHUNG∨¬LENGTH(HANG_STR[I]) THEN
BEGIN
COUNT ← PTIFRE(PTYLIN[I]);
IF LENGTH(STR)≤COUNT THEN
BEGIN
SEND(I,STR,TRUE);
DONE;
END;
END;
HANG_STR[I] ← HANG_STR[I]&STR;
JOBHUNG←TRUE;
DONE;
END;
IF I=MAXJOB+1 THEN
L3: TYPEX(TRUE,"UNKNOWN DESTINATION-"&CURDEST CRM);
END "SEND";
TSTR1 ← TSTR2 ← STR ← NULL;
END;
⊃ This is the command decoder, and is called by COMSCAN if a
command is detected. This parses the command, looks it up in the command
table, and may then parse arguments to the command. If arguments
are parsed, they are stored in ARGS[1], ARGS[2], ... The command
name itself is stored in ARGS[1]. Then we dispatch on the
command number in the low order 6 bits of COMACT for this
command. This dispatch is in the form of one big case
statement.;
PROCEDURE COMMAND(STRING CD);
BEGIN STRING FOOX,CDX,CMDSTR;
LABEL RAID, L2, L1, CAS, SYSCOM;
DEFINE TR="TRAC(CMDSTR,""MON"")";
INTEGER I,J,B,A, FLAG;
PROCEDURE TRAC(STRING A,B);
BEGIN STRING NAM;
IF BIT(TRACEB,MODE[MONINDX]) THEN
BEGIN
NAM←IF DSKFLAG THEN "DISK" ELSE
IF LENGTH(MACRSTRING) THEN "MACR" ELSE "TTY";
OUT(TRACECHN,NAM&"→"&B&" "&A&CRLF);
END;
END;
A←SCAN(CD,SKPDELIM,FLAG);
CDX ← CMDSTR←CD;
FOOX ← SCAN(CDX,TILDELIM,FLAG);
FOR J←1000 STEP 1 UNTIL MACRTOP-1 DO
IF LENGTH(FOOX)∧EQU(FOOX,MACNAM[J]) THEN
BEGIN
TR;
MACSTACK[MACDEPTH←MACDEPTH+1]←MACRSTRING; ⊃ PUSH ;
IF (B←MACARG[J])≠NULL THEN
BEGIN
I ← 0;
IF FLAG THEN DO
ARGS[I←I+1]←SCAN(CDX,TILCOMMA,FLAG)
UNTIL ¬FLAG;
MACRSTRING ← NULL;
SETBREAK(TILBREAK,B,NULL,"I");
CD ← MACRO[J];
WHILE TRUE DO
BEGIN
MACRSTRING←MACRSTRING&
SCAN(CD,TILBREAK,FLAG);
IF ¬FLAG THEN DONE;
IF "1"≤(J←CD[1 FOR 1])≤"9" THEN
BEGIN
CD←IF LENGTH(CD)>1 THEN
CD[2 TO ∞] ELSE NULL;
IF (J←J-"0")≤I THEN
MACRSTRING←MACRSTRING
&ARGS[J];
END ELSE
MACRSTRING ← MACRSTRING&B;
END;
END ELSE MACRSTRING ← MACRO[J];
FOOX ← CDX ← NULL;
RETURN;
END;
FOOX ← CDX ← NULL;
FOR I←1 STEP 1 UNTIL COMNO DO IF LENGTH(CD)≥COMLEN[I] THEN
IF EQU(CD[1 FOR COMLEN[I]],COMSTR[I][1 FOR COMLEN[I]]) THEN
BEGIN "CO2"
B←(COMACT[I] LAND '7700) LSH -6;
IF B≤0 THEN DONE; ⊃ NO PARAMS-- CALL PROD ;
FOR J←1 STEP 1 UNTIL (IF B>9 THEN 10 ELSE B+1) DO
BEGIN "CO3"
A←SCAN(CD,SKPDELIM,FLAG);
IF FLAG=0 THEN IF B='77 THEN
BEGIN
ARGS[J]←NULL;
DONE;
END ELSE BEGIN
TR;
L2: TYPEX(TRUE,"NOT ENOUGH PARAMETERS" CRM);
RETURN;
END;
IF "0"≤FLAG≤"9" ∨ "a"≤FLAG≤"z" ∨ "A"≤FLAG≤"Z" THEN
ARGS[J]←SCAN(CD,IDENT,FLAG)
ELSE BEGIN
CD←CD[2 TO ∞];
ARGS[J]←FLAG;
END;
END "CO3";
DONE;
END "CO2";
⊃ check for command errors;
IF I=COMNO+1 THEN
BEGIN
TR;
TYPEX(TRUE,"UNKNOWN COMMAND-"&CMDSTR CRM);
RETURN;
END;
IF BIT(COMACT[I],'10000) THEN GO TO L1;
IF (COMJOB=MAXJOB+1)∨(¬LENGTH(CURCOM)∧NOVICE) THEN
BEGIN
TR;
TYPEX(TRUE,"NO SUCH LOGICAL NAME-"&CURCOM CRM);
RETURN;
END;
IF COMJOB=1∧¬BIT(COMACT[I],'20000) THEN
BEGIN
TR;
TYPEX(TRUE,"ILLEGAL FOR MONITOR-"&CMDSTR CRM);
RETURN;
END;
IF ¬COMJOB∧¬BIT(COMACT[I],'40000) THEN
BEGIN
TR;
TYPEX(TRUE,"SPECIFY ONE DESTINATION-"&CMDSTR CRM);
RETURN
END;
⊃ COMMAND CASE STATEMENT - still inside COMMAND procedure;
L1: I ← COMACT[I] LAND '77;
IF I≠3∧I≠4 THEN TR;
CASE(I) OF
BEGIN
⊃ Login ---- LOGNAM:Login prj,prg ;
BEGIN "LOG" STRING ZZZ;
LABEL LOGLAB;
IF COMJOB<MAXJOB+1 THEN
BEGIN
TYPEX(TRUE,"ALREADY LOGGED IN-"&CURCOM CRM);
RETURN;
END;
FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I]=0 THEN DONE;
IF I=MAXJOB+1 THEN
BEGIN
TYPEX(TRUE,"MAXIMUM SUBJOB COUNT EXCEEDED" CRM);
RETURN;
END;
PTYLIN[I]←PTYGET;
IF ¬ _SKIP_ THEN
BEGIN
TYPEX(TRUE,"NO PTY TODAY" CRM);
RETURN
END;
LOGNAM[I]←CURCOM;
PTYSTL(PTYLIN[I],PTYGTL(PTYLIN[I]) LOR '6000000 LAND LNOT '10000000);
⊃ NO DUPLEX OR MOD 35 TABS;
MODE [I]←0; ⊃ WORD MODE;
SNARF_STRING ← NULL;
IF LENGTH(ARGS[2]) THEN ZZZ ← ARGS[2]&"/"&ARGS[4] ELSE
BEGIN
ZZZ ← CVXSTR(CALL(0,"GETPPN"));
ZZZ ← ZZZ[1 FOR 3]&"/"&ZZZ[4 FOR 3];
END;
SEND (I,"L "&ZZZ&CRLF,TRUE);
SNARF(I,'15);
SNARF(I,".");
IF LENGTH(SNARF_STRING)>7∧EQU(SNARF_STRING[1 TO 7],"Job Cap") THEN
BEGIN
TYPEX(TRUE,SNARF_STRING&" _ "&LOGNAM[I] CRM);
RETURN;
END;
JOBNO[I] ← IF LENGTH(SNARF_STRING)<5 THEN 0 ELSE
CVD(SNARF_STRING[5 TO ∞]);
IF ¬(0<JOBNO[I]<64) THEN
BEGIN
TYPEX(TRUE,"INVALID JOB NUMBER" CRM);
GO TO LOGLAB;
END;
TRACFLAG ← TRUE;
IF ¬SNARFMON(I) THEN
BEGIN
LOGLAB: TYPEX(TRUE,"LOGIN FAILED"&CRLF&SNARF_STRING&CRLF&
PTYALL(PTYLIN[I]) CRM);
JOBNO[I] ← 0;
PTYREL(PTYLIN[I]);
RETURN;
END;
IF ¬LENGTH(ARGS[2]) THEN
BEGIN "ALIAS" INTEGER G, D;
G ← CALL(0,"GETPPN");
D ← CALL(0,"DSKPPN");
IF G≠D THEN
BEGIN
ZZZ ← CVXSTR(D);
ZZZ ← " ALIAS "&ZZZ[1 FOR 3]&","&ZZZ[4 FOR 3];
SEND(I,ZZZ&CRLF,TRUE);
END ELSE ZZZ←NULL;
END "ALIAS" ELSE ZZZ←NULL;
TYPEX(FALSE,LOGNAM[I]&" LOGGED IN AS JOB "&CVS(JOBNO[I])&ZZZ CRM);
COMJOB ← I;
DPYCLEAR(LOGNAM[I],TRUE);
END; ⊃ OF LOGIN ;
⊃ KILL ;
BEGIN INTEGER THIS_IS_TEMPORARY_UNTIL_A_SAIL_BUG_IS_FIXED;
SIMPLE PROCEDURE KJOB(INTEGER I);
BEGIN INTEGER J;
DEFINE ZZ(A,B,C,D,E)="D←FALSE";
FOR J←1 STEP 1 UNTIL NUMBJOB DO
IF EQU(JOB_NAME[J],CURCOM) THEN DONE;
IF J≤NUMBJOB THEN J←CASE J-1 OF (JBS);
PUT_DATA(-1,JOBNO[I],"");
PTYREL(PTYLIN[I]);
TYPEX(FALSE,"JOB "&CVS(JOBNO[I])&" KILLED" CRM);
DPYCLEAR(JOBNO[I],TRUE);
JOBNO[I] ← 0;
END;
HALT;
IF COMJOB THEN KJOB(COMJOB) ELSE FOR I←2 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I] THEN KJOB(I);
END;
⊃ HALT ;
HALT;
⊃ RPG COMMANDS -- INDEX IS '3 ;
BEGIN
HALT;
SEND (COMJOB,CMDSTR&CRLF,TRUE)
END;
⊃ MISCELLANEOUS SYSTEM COMMANDS, INCLUDING RUN,GET,SAVE,ALIAS,
FINISH,PJOB,PPPN,REENTER,START,TIME,CONT ... INDEX IS '4;
SYSCOM: BEGIN
HALT;
IF COMJOB THEN SEND (COMJOB,CMDSTR&CRLF,TRUE) ELSE
FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I] THEN
SEND(I,CMDSTR&CRLF,TRUE);
END;
⊃ CHARACTER MODE -- INDEX IS '5;
BEGIN
IF COMJOB THEN MODE[COMJOB]←MODE[COMJOB] LOR 1 ELSE
FOR I←1 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I] THEN MODE[I]←MODE[I] LOR 1;
MODE[MONINDX] ← MODE[MONINDX] LAND (-2);
⊃ Suppress TTY char mode for now;
END;
⊃ LINE MODE -- INDEX IS '6;
IF COMJOB THEN MODE [COMJOB]←MODE[COMJOB] LAND (-2) ELSE
FOR I←1 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I] THEN MODE[I]←MODE[I] LAND (-2);
⊃ RAID MODE -- INDEX IS '7;
BEGIN INTEGER J,K,FLAG;
RAID: FLAG ← TRUE;
K ← 0;
DO BEGIN
FLAG ← K≠'701;
IF (K←INCHRW)≠'701 THEN PTOCHW(PTYLIN[COMJOB],K);
WHILE (J←PTCHRS(PTYLIN[COMJOB]))>0 DO OUTCHR(J) ;
END UNTIL ¬FLAG; ⊃ <C3> A TO TERMINATE.;
END;
⊃ EOF - INDEX IS '10 ; SEND (COMJOB,'32,TRUE);
⊃ DD -- INDEX IS '11 ;
BEGIN
HALT;
SEND (COMJOB,"DD"&CRLF,TRUE);
GO RAID;
END;
⊃ SUPPRESS -- INDEX IS '12 ;
IF COMJOB THEN MODE[COMJOB]←MODE[COMJOB] LOR SUPPRESS ELSE
FOR I←2 STEP 1 UNTIL MAXJOB DO MODE[I]←MODE[I] LOR SUPPRESS;
⊃ UNSUPPRESS -- INDEX IS '13 ;
IF COMJOB THEN MODE[COMJOB]←MODE[COMJOB] LAND (-1 ⊗ SUPPRESS) ELSE
FOR I←2 STEP 1 UNTIL MAXJOB DO MODE[I]←MODE[I] LAND (-1 ⊗ SUPPRESS);
⊃ UPDATE -- INDEX IS '14 ;
BEGIN INTEGER THIS_IS_THE_SECOND_FIX_OF_THIS_BUG;
SIMPLE PROCEDURE UPD(INTEGER I);
IF I=MONINDX THEN
BEGIN
CLOSE (TRACECHN);
OPEN (SUBCHN,"DSK",0,2,0,200,BREAK,EOF2);
LOOKUP (SUBCHN,TRACFIL,EOF);
IF EOF THEN TYPEX(TRUE,"TRACE LOOKUP FAILED" CRM)
ELSE BEGIN
ENTER (TRACECHN,TRACFIL,EOF);
IF EOF THEN TYPEX(TRUE,
"TRACE ENTER FAILED" CRM);
END;
IF ¬EOF THEN DO
OUT(TRACECHN,INPUT(SUBCHN,TILCR)&CRLF)
UNTIL EOF2 ELSE RELEASE(TRACECHN);
RELEASE(SUBCHN);
TYPEX(FALSE,"UPDATE FINISHED" CRM);
END;
IF COMJOB THEN UPD(COMJOB) ELSE FOR I←1 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I] THEN UPD(I);
END;
⊃ TRACE -- INDEX IS '15 ;
BEGIN
IF COMJOB THEN MODE[COMJOB]←MODE[COMJOB] LOR TRACEB ELSE
FOR I←1 STEP 1 UNTIL MAXJOB DO MODE[I]←MODE[I] LOR TRACEB;
TRACING ← BIT(MODE[MONINDX],TRACEB);
END;
⊃ UNTRACE -- INDEX IS '16 ;
BEGIN
IF COMJOB THEN MODE[COMJOB]←MODE[COMJOB] LAND (-1 ⊗ TRACEB) ELSE
FOR I←1 STEP 1 UNTIL MAXJOB DO MODE[I]←MODE[I] LAND (-1 ⊗ TRACEB);
TRACING ← BIT(MODE[MONINDX],TRACEB);
END;
⊃ DEFINE -- TAKES AS ARGUMENT THE NAME AND THE ARGUMENT CHARACTER, IF ANY
ACCEPTS ALL FOLLOWING LINES AS PART OF THE
MACRO. FIRST BLANK LINE TERMINATES
;
BEGIN INTEGER I, J;
J ← MACRTOP;
FOR I ← 1000 STEP 1 UNTIL MACRTOP-1 DO IF EQU(MACNAM[I],ARGS[2]) THEN
BEGIN
TYPEX(FALSE,"REDEFINING MACRO "&ARGS[2] CRM);
J ← I;
DONE;
END;
IF J>MAXMACRO THEN
BEGIN
TYPEX(TRUE,"MACRO LIMIT EXCEEDED" CRM);
RETURN;
END;
MACNAM[J]←ARGS[2]; MACARG[J] ← ARGS[3];
MACRO[J]←NULL;
DO BEGIN "COLECT"
SAVSTR[MONINDX] ← NULL;
DO BEGIN "SCAN"
SCANLOOP;
IF ¬MONWAK THEN INTWAIT;
END "SCAN" UNTIL MONWAK;
TRAC(SAVSTR[MONINDX],"MACR");
MACRO[J]←MACRO[J]&SAVSTR[MONINDX]&CRLF;
END "COLECT" UNTIL ¬LENGTH(SAVSTR[MONINDX]);
TYPEX(FALSE,MACNAM[J]&" DEFINED" CRM);
IF J=MACRTOP THEN MACRTOP ← MACRTOP+1;
END;
⊃ DISKIN, FOLLOWED BY FILE-NAME, READS IN FILE AS COMMANDS ;
BEGIN INTEGER I, J;
DEFINE IFCHAR(B)="(I←ARGS[B])=NULL∨I<""0""∨""9""<I<""A""∨
""Z""<I<""a""∨""z""<I";
STRING NAME;
IF DSKFLAG THEN
BEGIN
TYPEX(TRUE,"RECURSIVE CALL ON DISKIN" CRM);
RETURN;
END;
IF IFCHAR(2) THEN GO TO L2 ELSE NAME ← ARGS[2];
J ← 3;
IF ARGS[3]="." THEN IF IFCHAR(4) THEN GO TO L2 ELSE
BEGIN
NAME ← NAME&ARGS[3]&ARGS[4];
J ← 5;
END;
IF ARGS[J]="[" THEN IF IFCHAR(J+1)∨ARGS[J+2]≠","∨
IFCHAR(J+3)∨ARGS[J+4]≠"]" THEN GO TO L2 ELSE
WHILE ARGS[J]≠NULL DO
BEGIN
NAME←NAME&ARGS[J];
J←J+1;
END;
OPEN (DSKCHN,"DSK",0,2,0,200,EOFDSK,BREAKDSK);
LOOKUP (DSKCHN,NAME,BREAKDSK);
IF BREAKDSK THEN
BEGIN
TYPEX(FALSE,"FILE NOT FOUND" CRM);
RETURN;
END;
DSKFLAG←TRUE; ⊃ GOT THE FILE;
END;
⊃ RESTART - INDEX IS 21;
BEGIN INTEGER I, NAM, DEV, TRACF;
DEFINE ZZ(A,B,C,D,E)="D←FALSE";
COMJOB ← 0;
HALT;
DSKFLAG ← TRACFLAG ← MACDEPTH ← 0;
RELEASE(DSKCHN);
NAM ← DEV ← 0;
IF LENGTH(ARGS[2]) THEN IF ARGS[3]=":" THEN
BEGIN
DEV ← CVSIX(ARGS[2]);
IF LENGTH(ARGS[4]) THEN NAM ← CVSIX(ARGS[4]);
END ELSE NAM ← CVSIX(ARGS[2]);
TRACF←TRACING;
HEINIT(JOBNO[1], NAM, DEV);
TRACING←TRACF;
INITFLAG ← TRUE;
SCANLOOP;
FOR I←1 STEP 1 UNTIL MAXJOB DO IF JOBNO[I] THEN
BEGIN
MODE[I]←MODE[I] LAND (-1⊗ TTYMOD);
ACT_HE[I] ← 0;
PARTSTR[I] ← SAVSTR[I] ← NULL;
END;
_JCNT_ ← 0;
COMJOB←MONINDX;
FOR I←1 STEP 1 UNTIL NUMBJOB DO J←CASE I-1 OF (JBS);
END;
⊃ STATUS - INDEX IS 22;
BEGIN INTEGER I, J;
SIMPLE PROCEDURE STAT(INTEGER I);
BEGIN STRING FOO, TMP, FOOX;
INTEGER J, D1, D2, K;
LABEL L1, L2;
FOO ← CVS(J←JOBNO[I])&" ";
START_CODE DEFINE MOVE="'200000000000";
MOVE 1,J;
MOVE 2,_JCNT_;
SETOM J;
L2: SOJL 2,L1;
HRRZ 3,(2)_JTAB_;
CAIE 1,(3);
JRST L2;
MOVEM 3,J;
MOVE 3,(2)_JD1_;
MOVEM 3,D1;
MOVE 3,(2)_JD2_;
MOVEM 3,D2;
L1: END;
FOOX ← (IF CALL(C213+K,"PEEK") THEN "1" ELSE NULL)&
(IF CALL(C230+K,"PEEK") THEN "6" ELSE NULL);
TMP ← CVXSTR(CALL(K←JOBNO[I],"GETPPN"));
FOO ← FOO&FORM((IF J>0 THEN (CVSTRX(D1)&(IF D2 THEN
CVSTRX(D2) ELSE "")) ELSE ""),8)&
FORM(IF LENGTH(HANG_STR[I]) THEN "HUNG" ELSE NULL,6)&
FORM((IF LENGTH(FOOX) THEN "SW" ELSE NULL)&FOOX,6)&
FORM(CVXSTR(CALL(C225+K,"PEEK")),9)&
FORM(TMP[1 FOR 3]&","&TMP[4 FOR 3],9)&
FORM(CVSTR(CALL(C235+ABS(CALL(C231+K,"PEEK")),
"PEEK")),6)&FORM(CVS(CORE(K))&"K",5)&
FORM(TIMOUT(J←CALL(K,"RUNTIM")),10)
&TIMOUT(-TIME[I]+(TIME[I]←J));
OLDOUT ← NULL;
TYPEX(FALSE,FOO&CRLF,I);
FOOX ← TMP ← NULL;
END;
IF COMJOB THEN STAT(COMJOB) ELSE
BEGIN
MAX_SIZE ← TOTAL_SIZE ← 0;
FOR I←2 STEP 1 UNTIL MAXJOB DO IF JOBNO[I] THEN STAT(I);
CORE(MONNUM);
TOTAL_SIZE ← TOTAL_SIZE+(I←(CALL(0,"SEGSIZ")+1) DIV 1024);
TYPEX(FALSE,CRLF&"TOTAL CORE = "&CVS(TOTAL_SIZE)&
"K UPPER SEG="&CVS(I)&"K MAX="&
CVS(J←(CALL(C216,"PEEK")+1) DIV 1024)
&"K "&CVS(J-MAX_SIZE-I)&"K LEFT" CRM);
END;
END;
⊃ SET - Takes one argument, D(EBUG), T(YPE), or DI(SPLAY).
Index is 23;
BEGIN
FLAG ← TRUE;
GO TO CAS;
END;
⊃ RESET - Takes one argument as above. Index is 24;
BEGIN
FLAG ← FALSE;
CAS: I ← ARGS[2];
IF I="D" THEN I←IF LENGTH(ARGS[2])>1 THEN ARGS[2][2 FOR 1] ELSE "E";
IF COMJOB THEN DOIT(CURCOM,I,FLAG) ELSE
FOR J←1 STEP 1 UNTIL NUMBJOB DO
DOIT(JOB_NAME[J],I,FLAG);
END;
⊃ DUMP - INDEX IS 25;
BEGIN "DUMP"
INTEGER I, J;
REAL ARRAY TRAN[1:1024];
DEFINE ZZ(A,B,C,D,E)="D←FALSE";
_JCNT_ ← COMJOB ← 0;
HALT;
OUTSTR("ENTER GLOBAL MODEL FILENAME"&CRLF);
OPEN(SUBCHN,"DSK",'13,0,2,200,I,I);
ENTER(SUBCHN,INCHWL&".REL",I);
FOR I←1 STEP 1 UNTIL NUMBJOB DO J←CASE I-1 OF (JBS);
START_CODE DEFINE CALLI="'47000000000";
CALLI 1,'400022;
TRO 1,'400000;
MOVEM 1,I;
END;
FOR J←'400000 STEP 1024 UNTIL I DO
BEGIN
START_CODE
HRL 1,J;
HRR 1,TRAN;
HRRZ 2,TRAN;
BLT 1,1023(2);
END;
ARRYOUT(SUBCHN,TRAN[1],1024);
END;
RELEASE(SUBCHN);
OUTSTR("DUMP FINISHED"&CRLF);
PUT_DATA(0,0,"TRACE");
END "DUMP";
⊃ system commands which turn off the display
index is 26;
BEGIN "DPYOFF"
IF COMJOB THEN DPYCLEAR(JOBNO[COMJOB],TRUE) ELSE
FOR I←2 STEP 1 UNTIL MAXJOB DO
IF JOBNO[I] THEN DPYCLEAR(JOBNO[I],TRUE);
GO TO SYSCOM;
END "DPYOFF";
⊃ EXPERT AND NOVICE SWITCH - INDEX 27 AND 30;
NOVICE ← FALSE;
NOVICE ← TRUE;
⊃ RUN COMMAND must delay for now, until user state-index 31;
BEGIN "RUN"
DPYCLEAR(JOBNO[COMJOB],TRUE);
HALT;
SEND(COMJOB,CMDSTR&CRLF,TRUE);
CALL(1,"SLEEP");
END "RUN";
⊃ ************** END OF COMMAND ROUTINES *************** ;
END ⊃ OF CASE STATEMENT .......;
END; ⊃ OF PROCEDURE COMMAND;
⊃ ********** Execution Block ********** ;
CURDEST ← CURCOM ← MACRSTRING ← NULL;
NOVICE ← DSKFLAG ← HANG_CNT ← TRACFLAG ← COMJOB ← MACDEPTH ← 0;
JOBNO[MONINDX] ← -1;
LOGNAM[MONINDX] ← "MON";
MACRTOP←1000;
MONNUM ← CALL(0,"PJOB");
BLANKS← " ";
C223 ← CALL('223,"PEEK");
C212 ← CALL('212,"PEEK");
C230 ← CALL('230,"PEEK");
C213 ← CALL('213,"PEEK");
C216 ← CALL('216,"PEEK");
C225 ← CALL('225,"PEEK");
C231 ← CALL('231,"PEEK");
C235 ← CALL('235,"PEEK");
SETBREAK(TILSEMI,";",NULL,"I");
SETBREAK(TILCOLON,":",NULL,"I");
SETBREAK(TILDELIM," ",NULL,"I");
SETBREAK(SKPDELIM," ",NULL,"XR");
SETBREAK(IDENT," /.,;][()&%$#!*:=-@+←'",NULL,"IR");
SETBREAK(TILCR,'12,'15,"IN");
SETBREAK(TILCOMMA,",",NULL,"I");
WAK ← -1;
START_CODE DEFINE TTY="'51000000000";
TTY 6,WAK;
END;
DISDEV ← 1;
IF WAK<0 THEN DISDEV←2;
IF WAK LAND '20000000000 THEN DISDEV←3;
INTINT(TRUE,TRUE,TRUE);
INIT: INITFLAG ← FALSE;
OPEN(SUBCHN,"DSK",0,1,1,200,BREAK,EOF);
LOOKUP(SUBCHN,"$RUN$.DBG[SYS,HE]",EOF);
RUN←IF EOF THEN 0 ELSE CVD(INPUT(SUBCHN,TILCR));
CLOSE(SUBCHN);
ENTER(SUBCHN,"$RUN$.DBG[SYS,HE]",EOF);
RUN ← RUN+1;
IF ¬EOF THEN OUT(SUBCHN,CVS(RUN)&CRLF);
RELEASE(SUBCHN);
SETFORMAT(1,0);
TRACFIL ← "TRAC"&CVS(RUN MOD 100)&".DBG";
OPEN(TRACECHN,"DSK",0,0,2,200,BREAK,EOF);
ENTER (TRACECHN,TRACFIL,EOF);
IF EOF THEN TYPEX(TRUE,"CANNOT ENTER TRACE FILE" CRM);
JOBHUNG ← GDISP_INIT ← FALSE;
PUT_DATA(0,0,"TRACE");
TYPEX(FALSE,"RUN "&CVS(RUN) CRM);
SCANLOOP;
⊃ main loop;
WHILE TRUE DO BEGIN
IF WAK THEN PROCESS_STRINGS;
IF MONWAK∨JOBHUNG THEN COMSCAN;
IF INITFLAG THEN
BEGIN
TYPEX(FALSE, "INITIALIZED"&CRLF,1);
RELEASE(TRACECHN);
GO TO INIT;
END;
WHILE MES←GET_ENTRY ('40120,"","TRACE","") DO
MES←QUEUE('600,MES);
SCANLOOP;
IF ¬(JOBHUNG∨WAK∨MONWAK∨MACDEPTH) THEN
BEGIN
INTWAIT;
SCANLOOP;
END;
END;
END;